home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / HEAPSPY.ZIP / HWLOCAL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  4.2 KB  |  171 lines
  1. {$A-,B-,E-,F-,G+,I-,K-,N-,O-,P-,Q-,R-,S-,T+,V-,W-,X+}
  2.  
  3. {**********************************************}
  4. {                                              }
  5. {   HeapSpy - HWLocal Module                   }
  6. {   Copyright (c) 1992  Borland International  }
  7. {                                              }
  8. {**********************************************}
  9.  
  10. unit HWLocal;
  11.  
  12. {$C MOVEABLE DEMANDLOAD DISCARDABLE}
  13.  
  14. interface
  15.  
  16. uses Wintypes, WinProcs, Objects, ODialogs, OWindows, BWCC, Strings,
  17.   Toolhelp, HWGlobal, HWHexDmp, HWBitmap;
  18.  
  19. type
  20.   PLocalWin = ^TLocalWin;
  21.   TLocalWin = object(TSortListWin)
  22.     HHeap: THandle;
  23.     constructor Init(AParent: PWindowsObject; AhHeap: Word; AModule: PChar);
  24.     procedure BuildList; virtual;
  25.     function HandleSelect(LeftClick: Boolean): Boolean; virtual;
  26.     function GetItemString(p: Pointer): PChar; virtual;
  27.     procedure DeleteItem(p: Pointer); virtual;
  28.     function Less(p1, p2: Pointer): integer; virtual;
  29.   end;
  30.  
  31. implementation
  32.  
  33. function DoTypeLit(Dest: Pchar; wHeapType, wType: Word;
  34.   Item: Pointer): PChar;
  35. var
  36.   Temp: array[0..6] of Char;
  37. begin
  38.   if wType = lt_Normal then
  39.     StrCopy(Dest,'Normal')
  40.   else if wType = lt_Free then
  41.     StrCopy(Dest,'Free')
  42.   else
  43.     case wHeapType of
  44.       Normal_Heap:
  45.         begin
  46.           Str(wType,Temp);
  47.           StrCat(StrCopy(Dest,'Block Type '),Temp);
  48.         end;
  49.       User_Heap:
  50.           StrCopy(Dest,LocalUserLit[wType]);
  51.       GDI_Heap:
  52.           StrCopy(Dest,LocalGDILit[wType]);
  53.     else
  54.       StrCopy(Dest,'>> Unknown Heap Type <<');
  55.     end;
  56.   DoTypeLit := Dest;
  57. end;
  58.  
  59.  
  60. constructor TLocalWin.Init;
  61. var
  62.   ATitle: array[0..30] of Char;
  63. begin
  64.   HHeap := AhHeap;
  65.   WVSPrintF(ATitle,'%s Local Heap',AModule);
  66.   inherited Init(AParent, ATitle, True);
  67. end;
  68.  
  69. procedure TLocalWin.BuildList;
  70. var
  71.   Local: TLocalEntry;
  72.   LP: PLocalEntry;
  73. begin
  74.   Local.dwSize := sizeof(TLocalEntry);
  75.   LocalFirst(@Local,HHeap);
  76.   repeat
  77.     with Local do
  78.     begin
  79.       New(LP);
  80.       Move(Local,LP^,Sizeof(TLocalEntry));
  81.       List^.AddString(PChar(LP));
  82.     end;
  83.   until not LocalNext(@Local);
  84. end;
  85.  
  86. function TLocalWin.GetItemString(p: Pointer): PChar;
  87. var
  88.   GL: PLocalEntry absolute p;
  89.   ListString: array[0..127] of Char;
  90.   Temp: array[0..80] of Char;
  91.   NumStr: array[0..20] of Char;
  92.   HexTemp: array[0..4] of Char;
  93. begin
  94.   with GL^ do
  95.   begin
  96.     HexW(ListString,wAddress);
  97.     StrCat(ListString,' H:');
  98.     StrCat(ListString,HexW(HexTemp,hHandle));
  99.     if wcLock = 0 then
  100.       StrCat(ListString,'         ')
  101.     else
  102.       StrCat(ListString,'  Locked ');
  103.     case wFlags of
  104.       1: StrCat(ListString,'Fixed    ');
  105.       4: StrCat(ListString,'Moveable ');
  106.     else
  107.       StrCat(ListString,'         ');
  108.     end;
  109.     DoTypeLit(Temp,wHeapType,wType,Ptr(HHeap,wAddress));
  110.     Str(wSize:7,NumStr);
  111.     StrCat(ListString,NumStr);
  112.     StrCat(ListString,'  ');
  113.     StrCat(ListString,Temp);
  114.     GetItemString := StrNew(ListString);
  115.   end;
  116. end;
  117.  
  118. procedure TLocalWin.DeleteItem;
  119. begin
  120.   FreeMem(p, Sizeof(TLocalEntry));
  121. end;
  122.  
  123. function TLocalWin.Less(p1,p2: Pointer): Integer;
  124. var
  125.   LE1: PLocalEntry absolute p1;
  126.   LE2: PLocalEntry absolute p2;
  127.   Key1,Key2: longint;
  128. begin
  129.   case SortOpt of
  130.     cm_sbAddress:
  131.       begin
  132.         Key1 := LE1^.wAddress;
  133.         Key2 := LE2^.wAddress;
  134.       end;
  135.     cm_sbHandle:
  136.       begin
  137.         Key1 := LE1^.hHandle;
  138.         Key2 := LE2^.hHandle;
  139.       end;
  140.     cm_sbSize:
  141.       begin
  142.         Key1 := (Longint(LE1^.wSize) shl 16) or LE1^.wAddress;
  143.         Key2 := (Longint(LE2^.wSize) shl 16) or LE2^.wAddress;
  144.       end;
  145.     cm_sbType:
  146.       begin
  147.         Key1 := (Longint(LE1^.wType) shl 16) or LE1^.wAddress;
  148.         Key2 := (Longint(LE2^.wType) shl 16) or LE2^.wAddress;
  149.       end;
  150.     cm_sbModule:
  151.       begin
  152.         Key1 := LE1^.waddress;
  153.         Key2 := LE2^.waddress;
  154.       end;
  155.   end;
  156.   Less := Compare32(Key1,Key2);
  157. end;
  158.  
  159. function TLocalWin.HandleSelect(LeftClick: Boolean): Boolean;
  160. var
  161.   GP: PLocalEntry;
  162. begin
  163.   HandleSelect := True;
  164.   GP := PLocalEntry(SendMEssage(List^.hWindow, lb_GetItemData,
  165.     List^.GetSelIndex, 0));
  166.   with Application^,GP^ do
  167.     MakeWindow(New(PHexDmpWin,Init(MainWindow, HHeap, wAddress, wSize)));
  168. end;
  169.  
  170. end.
  171.